I am a big fan of the Thomas Lady Terriers basketball team, and I am forever grateful to Wright Media and Newstalk KCLI for broadcasting Terrier and Lady Terrier sports on Terrier TV, allowing me to watch the games while living out of state.
I have recorded and maintained player and team statistics for each game of the current season, but now I want to be able to automate some of the aggregations and maybe create some customized plots and tables from these stats. Enter R.
2.1 Load Game Data
2.1.1 Raw Data
The raw data is in Excel and cannot be downloaded from this website. However, you can email me and I can send it to you.
Let’s load the data using the readxl package:
Code
# file pathpath<-here("_input_data/Lady-Terriers_STATS_updated-15JAN2024.xlsx")# sheet namessheets<-excel_sheets(path =path)# choose all but first two sheets and reverse their ordergames<-rev(sheets[-c(1, 2)])|>map_df(~read_excel( path =path, sheet =.x, range ="A4:V25", col_types ="text"), .id ="game")
2.1.2 Scores by Quarter
Code
# setupscores_by_qtr<-games|>filter(is.na(FTA))|>drop_na("Name")|>filter(Name!="SCORE BY QUARTER")|>mutate( team =str_to_title(Name), game =as.numeric(game))|>select(game, team, Q1_pts ="Fouls", Q2_pts ="2PA", Q3_pts ="2PM", Q4_pts ="PCT...6")|>mutate(across(c(Q1_pts:Q4_pts), as.numeric))# one row per quarter per teamscores_qtr_long<-scores_by_qtr|>pivot_longer( cols =-c(1,2), names_to ="qtr", values_to ="points")|>mutate(quarter =str_sub(qtr, start =2, end =2)|>as.numeric())|>select(1, 2, 5, 4)# one row per game per teamscores_qtr_wide<-scores_by_qtr|>select(game, team, q1 =Q1_pts, q2 =Q2_pts, q3 =Q3_pts, q4 =Q4_pts)|>mutate( h1 =q1+q2, h2 =q3+q4, g =h1+h2)|>set_variable_labels( game ="Game Number", team ="Team Name", q1 ="1st Quarter Points", q2 ="2nd Quarter Points", q3 ="3rd Quarter Points", q4 ="4th Quarter Points", h1 ="1st Half Points", h2 ="2nd Half Points", g ="Total Points")
Let’s calculate some more advanced player stats, but first we will need to calculate a few game-level team stats. Namely:
FGA - total field goals attempted (2PA + 3PA) by Thomas (TLT_FGA) or opponent (OPP_FGA)
FGM - total field goals made (2PM + 3PM) by Thomas (TLT_FGM) or opponent (OPP_FGM)
FTA - total free throws attempted by Thomas (TLT_FTA) or opponent (OPP_FTA)
3PA - total 3-pointers attempted by Thomas (TLT_3PA) or opponent (OPP_3PA)
OREB - total offensive rebounds by Thomas (TLT_OREB) or their opponent (OPP_OREB)
REB - total rebounds for Thomas (TLT_REB) or their opponent (OPP_REB)
TO - total turnovers for Thomas (TLT_TO) or their opponent (OPP_TO)
The TLT and OPP prefixes are acronyms for “Thomas Lady Terriers” and “opponent”, respectively. In the formulas below, the TLT prefix is implied for any stats/metrics that don’t have a prefix displayed.
True Shooting Percentage (TS_PCT) - this metric incorporates shooting efficiency for free throws, 2-point shots and 3-point shots:
TS\_PCT=\frac{PTS}{2\big(FGA+(0.44 \times FTA)\big)}
Estimated Possessions (POSS) - this estimates the number of posessions a team has in a game based on shots taken, offensive rebounds and turnovers:
It should be noted that POSS is a team metric only. This metric, while useful as a measure of pace, is also used to calculate some of the player metrics described below.
Rebounding Percentage (REB_PCT) - measures a player’s total rebounding contribution to the game, and is adjusted for time spent on the court:
REB\_PCT=\frac{REB \times \frac{32}{MIN}}{TLT\_REB+OPP\_REB}
If a player plays all 32 minutes of the game, this metric will provide the proportion of a player’s rebounds to the total game rebounds of both teams. For the average rebounder, this metric should be close to 0.1 since there is a 1 of 10 players on the court will get a given rebound.
Assist Ratio (AST_RT) - measures the percentage of teammate baskets a player assisted on, and is adjusted for time spent on the court:
If a team plays at a fast pace, this metric adjusts for pace because it’s based on total team possessions. This metric penalizes a player when teammates miss shots or turn the ball over.
Steal Percentage (STL_PCT) - proportion of opponent’s possessions in which a player gets a steal, and is adjusted for time spent on the court:
Player Efficiency (EFF) - this is a (somewhat crude) measure of player efficiency, which is an adjusted difference of positive stats to negative stats:
positive stats: points, rebounds, assists, steals and blocks
negative stats: missed field goals, missed free throws and turnovers
The sum of positive stats minus the sum of negative stats is then adjusted for time spent on the court:
$$ = (++++ \ -(-)-(-)-)
$$
Source Code
---author: Scott Stewartdate-modified: last-modified---# SetupFirst, we need to set up our environment. The code we need for loading packages can be expanded below.::: {.callout-note collapse="true"}## Load PackagesPackages:```{r}#| label: setup# load primary packageslibrary(here) # for relative directorieslibrary(showtext) # fontslibrary(readxl) # read data from Excellibrary(labelled) # column labellinglibrary(janitor) # 2-way tables; exploratory analysislibrary(scales) # formatting percentageslibrary(patchwork) # combining plotslibrary(ggeasy) # using column labels in plotslibrary(gt) # nice HTML tableslibrary(tinytable) # nice HTML/PDF tables without dependencieslibrary(gtExtras) # rich HTML tables (added on to functionality of {gt}library(dlookr) # creating data dictionarieslibrary(psych) # exploratory analysis; summary statslibrary(tidyverse) # multifunctional collection of packages# knitr options# knitr::opts_chunk$set(out.width = 700, out.height = 500)```:::# IntroductionI am a big fan of the Thomas Lady Terriers basketball team, and I am forever grateful to [Wright Media](https://wright.media/) and Newstalk KCLI for broadcasting Terrier and Lady Terrier sports on [Terrier TV](https://kclifm.com/kcli-fm-terrier-tv), allowing me to watch the games while living out of state.I have recorded and maintained player and team statistics for each game of the current season, but now I want to be able to automate some of the aggregations and maybe create some customized plots and tables from these stats. Enter R.## Load Game Data### Raw DataThe raw data is in Excel and cannot be downloaded from this website. However, you can email me and I can send it to you.Let's load the data using the **readxl** package:```{r}# file pathpath <-here("_input_data/Lady-Terriers_STATS_updated-15JAN2024.xlsx")# sheet namessheets <-excel_sheets(path = path)# choose all but first two sheets and reverse their ordergames <-rev(sheets[-c(1, 2)]) |>map_df(~read_excel(path = path, sheet = .x, range ="A4:V25",col_types ="text"),.id ="game")```### Scores by Quarter```{r}# setupscores_by_qtr <- games |>filter(is.na(FTA)) |>drop_na("Name") |>filter(Name !="SCORE BY QUARTER") |>mutate(team =str_to_title(Name),game =as.numeric(game)) |>select( game, team, Q1_pts ="Fouls",Q2_pts ="2PA",Q3_pts ="2PM",Q4_pts ="PCT...6") |>mutate(across(c(Q1_pts:Q4_pts), as.numeric))# one row per quarter per teamscores_qtr_long <- scores_by_qtr |>pivot_longer(cols =-c(1,2),names_to ="qtr",values_to ="points") |>mutate(quarter =str_sub(qtr, start =2, end =2) |>as.numeric()) |>select(1, 2, 5, 4)# one row per game per teamscores_qtr_wide <- scores_by_qtr |>select( game, team,q1 = Q1_pts,q2 = Q2_pts,q3 = Q3_pts,q4 = Q4_pts) |>mutate(h1 = q1 + q2,h2 = q3 + q4,g = h1 + h2) |>set_variable_labels(game ="Game Number",team ="Team Name",q1 ="1st Quarter Points",q2 ="2nd Quarter Points",q3 ="3rd Quarter Points",q4 ="4th Quarter Points",h1 ="1st Half Points",h2 ="2nd Half Points",g ="Total Points")``````{r}#| label: tbl-scores-by-qtr-raw#| tbl-cap: Scores by Quarter, Half and Gameqtr_wide_col_labs <- scores_qtr_widenames(qtr_wide_col_labs) <-as.character(var_label(qtr_wide_col_labs))tinytable::tt(qtr_wide_col_labs, theme ="striped")```### Opponent Game Stats```{r}opponent_stats <- games |>drop_na(Name) |>filter(Name !="THOMAS") |>slice_tail(n =3, by = game) |>slice_head(n =1, by = game) |>select(-c(2, 7, 10, 13, 16, 21, 22, 23)) |>mutate(game =as.numeric(game),# opponent = if_else(Name == "BFDC", "Burns Flat-Dill City", Name),opponent =str_to_title(Name),across(3:15, as.numeric), .after = Name) |>mutate(PF = Fouls, .after = TO) |>select(-c(Name, Fouls)) |>relocate(opponent, .after = game)```### Player Game Stats```{r}player_stats <- games |>drop_na(`#`) |>rename(number =`#`,name = Name,PF = Fouls) |>mutate(number =as.numeric(number),game =as.numeric(game),across(4:23, as.numeric)) |>select(-c(7, 10, 13, 16))```## Load Game InformationThis includes game types (home, road, or neutral), locations, opponents and dates:```{r}dates_prep <-rev(sheets[-c(1, 2)]) |>map_df(~read_excel(path = path, sheet = .x, range ="A1:U1",col_names =FALSE,col_types =c("date", "text", "text", "text", "text", "text", "text", "text","text", "text", "text", "text", "text", "text", "text", "text","text", "text", "text", "text", "text")),.id ="game")dates <- dates_prep |>mutate(game =as.numeric(game),date =as.Date(`...1`),location =str_sub(`...9`, start =3L, end =-1L),opponent =`...21`,.keep ="none") |>mutate(type =case_when( location =="Thomas"~"Home",str_detect(location, "\\*") ~"Tournament",str_detect(location, "\\†") ~"Tournament",str_detect(location, "\\‡") ~"Tournament",str_detect(location, "\\⁰") ~"Playoff",.default ="Away") |>factor(levels =c("Home", "Away", "Tournament", "Playoff")) |>fct_drop(),.after = date) |>mutate(location =if_else( type =="Tournament",str_sub(location, start =1L, end =-2L), location))```# Summarize Data## Opponent Game Stats```{r}opp_scores_qtr_wide <- scores_qtr_wide |>filter(team !="Thomas") |>select(1, 3:6)opp_summary <- dates |>select(game, date, location, type) |>left_join(opponent_stats, by ="game") |>left_join(opp_scores_qtr_wide, by ="game") |>mutate(team = opponent,PTS = FTM + (2*`2PM`) + (3*`3PM`),`2PT_PCT`=round(`2PM`/`2PA`, digits =3),`3PT_PCT`=round(`3PM`/`3PA`, digits =3),FT_PCT =round(FTM / FTA, digits =3),REB = OREB + DREB) |>select(-opponent) |>select( game, date, location, type, team, PTS, OREB, DREB, REB, AST, STL, BLK, TO, PF,`2PA`, `2PM`, `2PT_PCT`, `3PA`, `3PM`, `3PT_PCT`, FTA, FTM, FT_PCT, q1, q2, q3, q4)```## Thomas Game Stats```{r}tt_scores_qtr_wide <- scores_qtr_wide |>filter(team =="Thomas") |>select(1, 3:6)tt_dates <- dates |>select(game, date, location, type)tt_summary <- player_stats |>select(-c(2:3, 17:19)) |>summarise(across(PF:TO, sum),.by = game) |>left_join(tt_scores_qtr_wide, by ="game") |>right_join(tt_dates, by ="game") |>mutate(team ="Thomas",PTS = FTM + (2*`2PM`) + (3*`3PM`),`2PT_PCT`=round(`2PM`/`2PA`, digits =3),`3PT_PCT`=round(`3PM`/`3PA`, digits =3),FT_PCT =round(FTM / FTA, digits =3),REB = OREB + DREB) |>select( game, date, location, type, team, PTS, OREB, DREB, REB, AST, STL, BLK, TO, PF,`2PA`, `2PM`, `2PT_PCT`, `3PA`, `3PM`, `3PT_PCT`, FTA, FTM, FT_PCT, q1, q2, q3, q4)```## Combined Game Stats```{r}game_summaries <-bind_rows(tt_summary, opp_summary)``````{r}#| label: tbl-game-stats-by-team#| tbl-cap: Game Stats by Teamgame_summary_tt <- game_summaries |>arrange(game) |>select(game, date, type, team, PTS:TO) tinytable::tt(game_summary_tt, theme ="striped")```## Player Stats```{r}# one row per player per gameplayer_stats_detailed <- dates |>select(-location) |>left_join(player_stats, by ="game") |>select(-PTS) |>mutate(PTS = FTM + (2*`2PM`) + (3*`3PM`),`2PT_PCT`=round(`2PM`/`2PA`, digits =3),`3PT_PCT`=round(`3PM`/`3PA`, digits =3),FT_PCT =round(FTM / FTA, digits =3),REB = OREB + DREB) |>rename(`+/-`=`+ / -`) |>select( game, date, type, opponent, num = number, name, PTS, OREB, DREB, REB, AST, STL, BLK, TO, PF, MIN, `+/-`,`2PA`, `2PM`, `2PT_PCT`, `3PA`, `3PM`, `3PT_PCT`, FTA, FTM, FT_PCT)# one row per player - SUMSplayer_stats_sums <- player_stats_detailed |>summarise(num =first(num),G =n(),across(c(PTS:`2PM`, `3PA`, `3PM`, FTA, FTM), sum),.by = name) |>select(num, everything())# one row per player - MEANSplayer_stats_means <- player_stats_sums |>mutate(across(c(4:20),~round(.x / G, digits =1))) |>mutate(`2PT_PCT`=round(`2PM`/`2PA`, digits =3),`3PT_PCT`=round(`3PM`/`3PA`, digits =3),FT_PCT =round(FTM / FTA, digits =3),TS_PCT =round(PTS / (2* (`2PA`+`3PA`+ (0.44* FTA))), digits =3),`AST/TO`=round(AST / TO, digits =2) )``````{r}#| label: tbl-player-stats#| tbl-cap: Player Stats (averages per game)player_stats_tt <- player_stats_means |>arrange(desc(MIN)) |>select(1:4, 7:14) tinytable::tt(player_stats_tt, theme ="striped")```## Advanced Stats### DefinitionsLet's calculate some more advanced player stats, but first we will need to calculate a few game-level team stats. Namely:- $FGA$ - total field goals attempted (`2PA` + `3PA`) by Thomas (`TLT_FGA`) or opponent (`OPP_FGA`)- $FGM$ - total field goals made (`2PM` + `3PM`) by Thomas (`TLT_FGM`) or opponent (`OPP_FGM`)- $FTA$ - total free throws attempted by Thomas (`TLT_FTA`) or opponent (`OPP_FTA`)- $3PA$ - total 3-pointers attempted by Thomas (`TLT_3PA`) or opponent (`OPP_3PA`)- $OREB$ - total offensive rebounds by Thomas (`TLT_OREB`) or their opponent (`OPP_OREB`)- $REB$ - total rebounds for Thomas (`TLT_REB`) or their opponent (`OPP_REB`)- $TO$ - total turnovers for Thomas (`TLT_TO`) or their opponent (`OPP_TO`)The `TLT` and `OPP` prefixes are acronyms for "Thomas Lady Terriers" and "opponent", respectively. In the formulas below, the `TLT` prefix is implied for any stats/metrics that don't have a prefix displayed. **True Shooting Percentage** (`TS_PCT`) - this metric incorporates shooting efficiency for free throws, 2-point shots and 3-point shots:$$TS\_PCT=\frac{PTS}{2\big(FGA+(0.44 \times FTA)\big)}$$**Estimated Possessions** (`POSS`) - this estimates the number of posessions a team has in a game based on shots taken, offensive rebounds and turnovers:$$POSS=0.5 \times \big(FGA+(0.475 \times FTA)-OREB+TO\big)$$It should be noted that `POSS` is a *team metric only*. This metric, while useful as a measure of pace, is also used to calculate some of the player metrics described below.**Rebounding Percentage** (`REB_PCT`) - measures a player's total rebounding contribution to the game, and is adjusted for time spent on the court:$$REB\_PCT=\frac{REB \times \frac{32}{MIN}}{TLT\_REB+OPP\_REB}$$If a player plays all 32 minutes of the game, this metric will provide the proportion of a player's rebounds to the total game rebounds of both teams. For the average rebounder, this metric should be close to 0.1 since there is a 1 of 10 players on the court will get a given rebound.**Assist Ratio** (`AST_RT`) - measures the percentage of teammate baskets a player assisted on, and is adjusted for time spent on the court:$$AST\_RT=\frac{AST}{\bigg(\frac{MIN}{32}\times TLT\_FGM\bigg)-FGM}$$**Assist Percentage** (`AST_PCT`) - measures the proportion of player assists per team possession, and is adjusted for time spent on the court:$$AST\_PCT=\frac{AST}{\frac{MIN}{32}\times TLT\_POSS}$$If a team plays at a fast pace, this metric adjusts for pace because it's based on total team possessions. This metric penalizes a player when teammates miss shots or turn the ball over.**Steal Percentage** (`STL_PCT`) - proportion of opponent's possessions in which a player gets a steal, and is adjusted for time spent on the court:$$STL\_PCT=\frac{STL}{\frac{MIN}{32}\times OPP\_POSS}$$**Block Percentage** (`BLK_PCT`) - proportion of opponent's possessions in which a player gets a block, and is adjusted for time spent on the court:$$BLK\_PCT=\frac{BLK}{\frac{MIN}{32}\times OPP\_POSS}$$**Turnover Percentage** (`TOV_PCT`) - measures the proportion of player turnovers per team possession, and is adjusted for time spent on the court:$$TOV\_PCT=\frac{TO}{\frac{MIN}{32}\times TLT\_POSS}$$**Player Efficiency** (`EFF`) - this is a (somewhat crude) measure of player efficiency, which is an adjusted difference of positive stats to negative stats:1. positive stats: *points*, *rebounds*, *assists*, *steals* and *blocks*2. negative stats: *missed field goals*, *missed free throws* and *turnovers*The sum of positive stats minus the sum of negative stats is then adjusted for time spent on the court:$$\mathrm{EFF} = \frac{32}{\mathrm{MIN}}\Big(\mathrm{PTS}+\mathrm{REB}+\mathrm{AST}+\mathrm{STL}+\mathrm{BLK}\\\hspace{1.5cm}-(\mathrm{FGA}-\mathrm{FGM})-(\mathrm{FTA}-\mathrm{FTM})-\mathrm{TO}\Big)$$